COMMENT ⊗   VALID 00004 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	 Chart Making program for TEX output.
C00005 00003	 The lines of a box are segments. So a Box would look like:
C00008 00004	 Impl cpu gc cpu+gc real page
C00022 ENDMK
C⊗;
;;; Chart Making program for TEX output.
;;; This is for making charts of exactly what each implementation
;;; has reported in each benchmark
;;;	(...(benchmark 
;;;	     (impl1 entry1) (impl2 entry2)...) ...)
;;;
;;; For each benchmark:
;;;(...(benchmark
;;;     ((blankline))
;;;     ((indent 1) "Benchmark 3" (entry (f entry)))
;;;     ((center) "Random Text"))...)
;;;
;;; For each implementation:
;;;(...(impl "Top-row Information")...)


(declare (special *data* *benchmarks* *all-implementations* *leave-outs*
		  *subset-relationships* *all-benchmarks*))
(sstatus syntax #o45 (status syntax #o40))

(declare (special *benchmark-info*))

(setq *leave-outs* '(ti-exp))

(defun get-bench-data (bench)
       (cdr (assoc bench *data*)))

(defun get-bench-entry (impl full-entry)
       (cadr (assoc impl full-entry)))

(defmacro trunc (x)
	  `(//$ 
	    (float 
	     (fix 
	      (times 100.0 ,x))) 100.0))

(defun tsafe-quotient (x y)
       (cond ((and (numberp x)
		   (numberp y))
	      (cond ((and (zerop x)(zerop y))
		     1.0)
		    ((zerop y) '"$\infty$")
		    (t (round (quotient x y)))))))

(defun filter-out (l leave-outs)
       (mapcan #'(lambda (x)
			 (cond ((memq (car x)
				      leave-outs)
				())
			       (t (ncons x))))
	       l))
;;; The lines of a box are segments. So a Box would look like:
;;;	<blankline>
;;;	Division by 2
;;;	<blankline>
;;;	   Recursive
;;;	   Iterative
;;;	<blankline>

(declare (mapex t))

(defun make-a-chart (full-benchmark entry-fun)
       (princ "&&\hfil {\bf Implementation}\hfil&&")
       (princ "{\bf CPU}&&{\bf GC}&&$\hbox{\bf CPU}+\hbox{\bf GC}$&&{\bf Real}&&{\bf Paging}&\cr\tablerule")
       (make-rows full-benchmark
		  entry-fun)
       t)

(defun make-rows (full-benchmark entry-fun)
 (let  ((info
	 (get-bench-data full-benchmark)))
       (let ((data
	      (mapcar 
	       #'(lambda (impl)
			 (mapcar
			  #'(lambda (entry)
				    (cons (car entry)
					  (let ((stuff
						 (funcall entry-fun 
							  (get-bench-entry
							   (car impl)
							   info))))
					       (mapcar 
						#'(lambda (fun)
							  (and fun stuff
							       (funcall 
								fun stuff)))
						(cadr entry)))))
			  (cadr impl)))
	       (filter-out *all-implementations* *leave-outs*))))
	    (do ((data data (cdr data)))
		((null data) t)
		(do ((impl-entry (car data) (cdr impl-entry)))
		    ((null impl-entry))
		    (terpri)
		    (princ "&&")
		    (princ (caar impl-entry))
		    (cond ((null (cdar impl-entry))
			   (princ "&&&&&&&&&&&\cr")(terpri))
			  (t (do ((line (cdar impl-entry) (cdr line)))
				 ((null line) 
				  (cond ((not (null (cdr impl-entry)))
					 (princ "&\cr"))
					(t (princ "&\cr\tablerule")))
				  (terpri))
				 (princ "&&")
				 (cond ((null (car line)))
				       (t (princ (trunc (car line)))))))))))))
;;; Impl cpu gc cpu+gc real page

;;; (do-fchart 'tak)
;;; (do-fchart 'traverse)
;;; (do-fchart 'traverse-init)
;;; Look at *all-benchmarks* in DATA.BCH[TIM,LSP] to see the options.

(defun do-fchart (benchmark)
       (let ((entry (cdr (assq benchmark *subset-relationships*))))
	    (terpri)
	    (princ "\newbox\bigstrutbox")
	    (terpri)
	    (princ "\setbox\bigstrutbox=\hbox{\vrule height8.6pt depth3.6pt width0pt}")
	    (terpri)
	    (princ "\def\bigstrut{\relax\ifmmode\copy\bigstrutbox\else\unhcopy\bigstrutbox\fi}")
	    (terpri)
	    (cond (entry
		   (mapc #'(lambda (x) (do-fchart1 benchmark x)
				   (terpri)
				   (princ "\vfill\eject")
				   (terpri))(car entry)))
		  (t (do-fchart1 benchmark benchmark)))
	    t)))

(defun do-fchart1 (full-benchmark benchmark)
       (let ((n 5)(entry (cdr (assq benchmark *all-benchmarks*))))
	    (princ "$$\vbox{\tabskip=0pt \offinterlineskip")
	    (terpri)
	    (princ "\def\tablerule{\noalign{\hrule}}")
	    (terpri)
	    (princ "\halign {\bigstrut#& \vrule#\tabskip=1em plus2em&#& \vrule#&")
	    (do ((i (1- n) (1- i)))
		((zerop i)
		 (princ "\hfil#\hfil& \vrule#\tabskip=0pt\cr\tablerule")
		 (terpri)
		 (princ "&&\multispan{")(princ (1+ (* n 2)))
		 (princ "}\hfil {\bf Raw Time}\hfil&\cr")
		 (terpri)
		 (princ "&&\multispan{")(princ (1+ (* n 2)))
		 (princ "}{\hfil {\bf ")(princ (car entry))
		 (princ "}}\hfil&\cr\tablerule")
		 (terpri)
		 )
		(princ "\hfil#\hfil& \vrule#&")(terpri))
       (make-a-chart
	full-benchmark
	(cadr entry))
       (princ "}}$$")))